home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-06-15 | 3.1 KB | 120 lines | [TEXT/MWPS] |
- {Based on a demo by oster@netcom.com (David Phillip Oster),}
- {posted on alt.sources.mac in 1994.}
-
- {*******************************}
- {This version by Ingemar Ragnemalm.}
- {Uses an offscreen with selectable depth. With depth 1, as in the original program,}
- {I didn't manage to get any anti-aliasing at all. However, with depth 2, it changes}
- {altogether. Modify the kOffDepth constant below to try it.}
- {*******************************}
-
- unit AntiAlias;
-
- interface
- uses
- {$IFC UNDEFINED THINK_PASCAL}
- Types, QuickDraw, ToolUtils, Events, Menus, Dialogs, Fonts, Resources, Devices,
- {$ENDC}
- QDOffscreen;
-
- function ADrawString (text: Str255): OSErr;
- function ADrawText (text: Ptr; off, len: integer): OSErr;
-
- implementation
-
- const
- {Offscreen Depth. Originally 1. Set to 2 or more for a much nicer result .}
- kOffDepth = 2;
-
-
- (* ADrawString - draw a string using copybits antialiasing *)
- function ADrawString (text: Str255): OSErr;
- begin
- ADrawString := ADrawText(@text, 1, ord(text[0]));
- end;
-
- (* ADrawText - draw a text using copybits antialiasing *)
- function ADrawText (text: Ptr; off, len: integer): OSErr;
- var
- errCode: OSErr;
- savePort: CGrafPtr;
- saveDev: GDHandle;
- bigGWorld: GWorldPtr;
- curPort: GrafPtr;
- fInfo: FontInfo;
- theTextFace: Style;
- bwRect, destRect: Rect;
- theTextSize, theTextFont, width, height, smallAscent: Integer;
- begin
- GetPort(curPort);
- GetFontInfo(fInfo);
-
- smallAscent := fInfo.ascent;
- theTextFace := curPort^.txFace;
- theTextFont := curPort^.txFont;
- theTextSize := curPort^.txSize;
- TextSize(theTextSize * 4);
-
- width := TextWidth(text, off, len);
- width := width + 32 - width mod 32;
-
- GetFontInfo(fInfo);
- height := fInfo.ascent + fInfo.descent;
- height := height + 4 - height mod 4;
-
- TextSize(theTextSize);
-
- bwRect.left := 0;
- bwRect.top := 0;
- bwRect.right := width;
- bwRect.bottom := height;
-
- destRect := bwRect;
- destRect.right := destRect.right div 4;
- destRect.bottom := destRect.bottom div 4;
-
- OffsetRect(destRect, curPort^.pnLoc.h, curPort^.pnLoc.v - smallAscent);
-
- {If I use a bigger depth than 1 for the GWorld below, the result is much nicer! But slower!}
- {$IFC UNDEFINED THINK_PASCAL}
- errCode := NewGWorld(bigGWorld, kOffDepth, bwRect, nil, nil, 0);
- if noErr <> errCode then
- errCode := NewGWorld(bigGWorld, kOffDepth, bwRect, nil, nil, useTempMem);
- {$ELSEC}
- errCode := NewGWorld(bigGWorld, kOffDepth, bwRect, nil, nil, []);
- if noErr <> errCode then
- errCode := NewGWorld(bigGWorld, kOffDepth, bwRect, nil, nil, [useTempMem]);
- {$ENDC}
- if noErr <> errCode then
- begin
- ADrawText := errCode;
- exit(ADrawText);
- end;
-
- if LockPixels(GetGWorldPixMap(bigGWorld)) then
- ;
-
- GetGWorld(savePort, saveDev);
- SetGWorld(bigGWorld, nil);
-
- EraseRect(bwRect);
-
- TextSize(theTextSize * 4);
- TextFont(theTextFont);
- TextFace(theTextFace);
-
- MoveTo(0, fInfo.ascent);
- DrawText(text, off, len);
-
- SetGWorld(savePort, saveDev);
-
- CopyBits(GrafPtr(bigGWorld)^.portBits, curPort^.portBits, bwRect, destRect, BitOr(ditherCopy, curPort^.txMode), nil);
- Move(destRect.right - destRect.left, 0);
-
- UnlockPixels(GetGWorldPixMap(bigGWorld));
- DisposeGWorld(bigGWorld);
-
- ADrawText := errCode;
- end;
-
- end.